home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  23KB  |  860 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10                             }
  6.  
  7. Unit totDIR;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.          1.00a    3/25/91   Allowed typing of filename when no files
  13.                             in list.
  14.          1.00b    5/18/91   Added DIRinit to interface
  15.          1.00c    2/04/92   Trapped for ? * chars in path
  16. }
  17.  
  18. INTERFACE
  19.  
  20. uses DOS,CRT,
  21.      totIO1, totIO2, totLINK, totSTR, totSYS, totWIN,
  22.      totINPUT, totFAST, totMISC, totMsg;
  23.  
  24. CONST
  25.    SignalUpdateDirField  =  10;   {Signal ID}
  26.    SignalUpdateFileField =  11;
  27.    ReadMessage: string[20] = 'Reading files...';
  28.    SortMessage: string[20] = 'Sorting files...';
  29.  
  30. TYPE
  31.  
  32. pDirDLLOBJ = ^DirDLLOBJ;
  33. DirDLLOBJ = object (DLLOBJ)
  34.    vShowDrives: boolean;
  35.    {methods ...}
  36.    constructor Init;
  37.    procedure   FillList;
  38.    procedure   SetDrives(On:boolean);
  39.    function    GetStr(Node:DLLNodePtr;Start,Finish: longint):string;  VIRTUAL;
  40.    destructor  Done;
  41. end; {DirDLLOBJ}
  42.  
  43. pFilesFieldOBJ = ^FilesFieldOBJ;
  44. FilesFieldOBJ = object (ListIOOBJ)
  45.    vFileList: ^FileDLLOBJ;
  46.    vSortCode: byte;
  47.    vSortOrder: boolean;
  48.    {methods ...}
  49.    constructor Init;
  50.    procedure   SetFileDetails(FileMasks:string; FileAttrib: word);
  51.    procedure   SetSortDetails(SortCode: byte; SortOrder: boolean);
  52.    procedure   FillList;
  53.    function    GetChosenFile: string;
  54.    function    Select(K:word; X,Y:byte):TAction;                       VIRTUAL;
  55.    procedure   ShowItemDetails(HiPick: integer);                       VIRTUAL;
  56.    function    GetString(Pick:integer): string;                        VIRTUAL;
  57.    function    SelectPick(InKey:word;X,Y:byte): tAction;               VIRTUAL;
  58.    procedure   HandleSignal(var BaseSig:tSignal; var NewSig:tSignal);  VIRTUAL;
  59.    destructor  Done;                                                   VIRTUAL;
  60. end; {FilesFieldOBJ}
  61.  
  62. pDirFieldOBJ = ^DirFieldOBJ;
  63. DirFieldOBJ = object (ListIOOBJ)
  64.    vDirList: ^DirDLLOBJ;
  65.    {methods ...}
  66.    constructor Init;
  67.    procedure   FillList;
  68.    procedure   ReadDir(Status:tStatus);
  69.    function    Select(K:word; X,Y:byte):TAction;                       VIRTUAL;
  70.    function    GetString(Pick:integer): string;                        VIRTUAL;
  71.    function    SelectPick(InKey:word;X,Y:byte): tAction;               VIRTUAL;
  72.    procedure   RaiseSignal(var TheSig:tSignal);                        VIRTUAL;
  73.    procedure   HandleSignal(var BaseSig:tSignal; var NewSig:tSignal);  VIRTUAL;
  74.    destructor  Done;                                                   VIRTUAL;
  75. end; {DirFieldOBJ}
  76.  
  77. pFileInputFieldOBJ = ^FileInputFieldOBJ;
  78. FileInputFieldOBJ = object (LateralIOOBJ)
  79.    vChangeDir: boolean;
  80.    vChangeMask: boolean;
  81.    vLastInput: string;
  82.    {methods ...}
  83.    constructor Init;
  84.    procedure   SetLastValue(Mask:string);
  85.    procedure   WriteLabel(Status:tStatus);                             VIRTUAL;
  86.    function    ProcessEnter:tAction;                                   VIRTUAL;
  87.    procedure   RaiseSignal(var TheSig:tSignal);                        VIRTUAL;
  88.    procedure   ShutdownSignal(var BaseSig:tSignal);                    VIRTUAL;
  89.    function    Suspend:boolean;                                        VIRTUAL;
  90.    destructor  Done;                                                   VIRTUAL;
  91. end; {FileInputFieldOBJ}
  92.  
  93. pDirWinOBJ = ^DirWinOBJ;
  94. DirWinOBJ = object
  95.    vFileSpec: ^FileInputFieldOBJ;
  96.    vFileList: ^FilesFieldOBJ;
  97.    vDirList: ^DirFieldOBJ;
  98.    vOK:  Strip3DIOOBJ;
  99.    vCancel: Strip3DIOOBJ;
  100.    vHelp: Strip3DIOOBJ;
  101.    vControl: ControlKeysIOOBJ;
  102.    vManager: WinFormOBJ;
  103.    vOldDir: string[80];
  104.    vStartDir: string[80];
  105.    vEndDir: string[80];
  106.    {methods ...}
  107.    constructor Init;
  108.    function    Action: pWinFormOBJ;
  109.    function    Go: tAction;
  110.    procedure   SetFileDetails(StartDir:string; FileMasks:string; FileAttrib: word);
  111.    procedure   SetSortDetails(SortCode: byte; SortOrder: boolean);
  112.    function    Win: MoveWinPtr;
  113.    function    FilenameTyped:boolean;
  114.    function    GetChosenFile: string;
  115.    destructor  Done;                                                   VIRTUAL;
  116. end; {DirWinOBJ}
  117.  
  118. procedure DIRInit;
  119. IMPLEMENTATION
  120. var Floppies: byte;
  121. {|||||||||||||||||||||||||||||||||||||||||||||}
  122. {                                             }
  123. {     M i s c.  P r o c s   &   F u n c s     }
  124. {                                             }
  125. {|||||||||||||||||||||||||||||||||||||||||||||}
  126. procedure WriteFullDir;
  127. {}
  128. var Str:string;
  129. begin
  130.    GetDir(0,Str);
  131.    Screen.WritePlain(1,17,padleft(Str,45,' '));
  132. end; {WriteFullDir}
  133.  
  134. {$F+}
  135. procedure DirHelp(ID:word);
  136. {}
  137. var  HelpWin: MessageOBJ;
  138. begin
  139.    with HelpWin do
  140.    begin
  141.       Init(1,'File Load Help');
  142.       AddLine('Enter a filename (or file mask) in the Name ');
  143.       Addline('box, or TAB to the file list and select a');
  144.       Addline('file from the list by pressing Enter or ');
  145.       AddLine('double clicking the mouse.');
  146.       AddLine('');
  147.       AddLine('To change directories, TAB to the Directories');
  148.       AddLine('list and select one.');
  149.       AddLine('');
  150.       Show;
  151.       Done;
  152.    end;
  153. end; {DirHelp}
  154. {$IFNDEF OVERLAY}
  155.   {$F-}
  156. {$ENDIF}
  157. {|||||||||||||||||||||||||||||||||||||||||||}
  158. {                                           }
  159. {     D i r D L L O b j   M E T H O D S     }
  160. {                                           }
  161. {|||||||||||||||||||||||||||||||||||||||||||}
  162. constructor DirDLLOBJ.Init;
  163. {}
  164. begin
  165.    DLLOBJ.Init;
  166.    vShowDrives := true;
  167. end; {DirDLLOBJ.Init}
  168.  
  169. procedure DirDLLOBJ.SetDrives(On:boolean);
  170. {}
  171. begin
  172.    vShowDrives := On;
  173. end; {DirDLLOBJ.SetDrives}
  174.  
  175. procedure DirDLLOBJ.FillList;
  176. {}
  177. var
  178.   DirInfo: SearchRec;
  179.   Drive: string;
  180.   I : integer;
  181.   Result: longint;
  182.   Ecode : integer;
  183.   ActiveDrive: integer;
  184. begin
  185.    if vStartNodePtr <> Nil then
  186.       EmptyList;
  187.    FindFirst('*.*', AnyFile, DirInfo);
  188.    while DOSError = 0 do
  189.    begin
  190.       if ((DirInfo.Attr and Directory) = Directory)
  191.       and (DirInfo.Name <> '.') then
  192.       begin
  193.          Drive := '['+DirInfo.Name+']';
  194.          Ecode := Add(Drive,succ(length(Drive)));
  195.          if Ecode = 0 then
  196.             vActiveNodePtr^.SetStatus(0,true);  {indicates directory change}
  197.       end;
  198.       FindNext(DirInfo);
  199.    end;
  200.    if vShowDrives then  {get active drives}
  201.    begin
  202.       {$I-}
  203.       getdir(0,Drive);
  204.       {$I-}
  205.       if IOResult = 0 then
  206.          ActiveDrive := ord(Drive[1]) - 64
  207.       else
  208.          ActiveDrive := 0;
  209.       if (Floppies >= 1) and (ActiveDrive <> 1) then
  210.       begin
  211.          Drive := '[ -A- ]';
  212.          Ecode := Add(Drive,8);
  213.       end;
  214.       if (Floppies >= 2) and (ActiveDrive <> 2) then
  215.       begin
  216.          Drive := '[ -B- ]';
  217.          Ecode := Add(Drive,8);
  218.       end;
  219.       for I := 3 to 26 do {test all letters}
  220.       begin
  221.          Result := DiskSize(I);
  222.          if (Result <> -1) and (ActiveDrive <> I) then {valid drive}
  223.          begin
  224.             Drive := '[ -'+char(I+64)+'- ]';
  225.             Ecode := Add(Drive,8);
  226.          end;
  227.       end;
  228.    end;
  229.    Jump(1);
  230. end; {DirDLLOBJ.FillList}
  231.  
  232. function DirDLLOBJ.GetStr(Node:DLLNodePtr;Start,Finish: longint):string;
  233. {ignores Start and Finish parameters}
  234. var temp : string;
  235. begin
  236.    if (Node = Nil)
  237.    or (Node^.vDataPtr = Nil)
  238.    or (Node^.vSize = 0)  then
  239.       GetStr := ''
  240.    else
  241.    begin
  242.       Move(mem[seg(Node^.vDataPtr^):ofs(Node^.vDataPtr^)],Temp[0],15);
  243.       GetStr := Temp;
  244.    end;
  245. end; {DirDLLOBJ.GetStr}
  246.  
  247. destructor DirDLLOBJ.Done;
  248. {}
  249. begin
  250.    DLLOBJ.Done;
  251. end; {DirDLLOBJ.Done}
  252. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  253. {                                                    }
  254. {     F i l e s F i e l d O B J   M e t h o d s      }
  255. {                                                    }
  256. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  257. constructor FilesFieldOBJ.Init;
  258. {}
  259. begin
  260.    ListIOOBJ.Init(